home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / VECTOR.ZIP / VECTOR.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1996-12-27  |  3.1 KB  |  162 lines

  1. {
  2. The TVector component for Delphi was designed and implemented by:
  3.  
  4.  Berend Tober
  5.  22 Robin Hill Road
  6.  Waterford, CT 06385
  7.  
  8.  Compuserve: 70541,1030
  9.  
  10.  Internet:
  11.  btober@compuserve.com
  12.  btober@connix.com
  13.  
  14.  
  15.  The Vector Unit for Borland Delphi exports the TVector component
  16.  which is used to model vectors, i.e., the members of an
  17.  N-dimensional, real vector space.
  18. }
  19.  
  20. unit Vector;
  21.  
  22. interface
  23.  
  24. uses SysUtils, Classes;
  25.  
  26. type
  27.   EUnequalVectorLength = class(Exception);
  28.  
  29.   TVector = class(TList)
  30.   private
  31.     { Private declarations }
  32.      function GetElement(i: Word): Real;
  33.      function GetMagnitude: Real;
  34.      function GetMagSquared: Real;
  35.      procedure SetElement(x: Real; i: Word);
  36.   protected
  37.     { Protected declarations }
  38.   public
  39.     { Public declarations }
  40.      property Element[Index: Word]: Real Read GetElement;
  41.      property Magnitude: Real Read GetMagnitude;
  42.      property MagSquared: Real Read GetMagSquared;
  43.      function Add(x: Real): Integer;
  44.      procedure Scale(a:Real);
  45.      procedure Normalize;
  46.      function Clone: TVector;
  47.      procedure Sum(a: Real; v: TVector);
  48.      function Dot(v: TVector): Real;
  49.      procedure Destroy;
  50.   end;
  51.  
  52. implementation
  53.  
  54. function TVector.GetElement(i: Word): Real;
  55. var
  56.   ptrX: ^Real;
  57. begin
  58.   i := i-1;
  59.   ptrX := Items[i];
  60.   Result := ptrX^;
  61. end;
  62.  
  63. procedure TVector.SetElement(x: Real; i: Word);
  64. var
  65.   ptrX: ^Real;
  66. begin
  67.   i := i-1;
  68.   ptrX := Items[i];
  69.   ptrX^ := x
  70. end;
  71.  
  72. function TVector.Add(x: Real): Integer;
  73. var
  74.   ptrX: ^Real;
  75. begin
  76.   new(ptrX);
  77.   ptrX^ := x;
  78.   Result := 1+inherited Add(ptrX);
  79. end;
  80.  
  81. procedure TVector.Destroy;
  82. var
  83.   i: Word;
  84.   ptrX: ^Real;
  85. begin
  86. If Count > 0 then for i := 0 to (Count-1) do
  87.      begin
  88.      ptrX := Items[i];
  89.      Dispose(ptrX);
  90.      end;
  91.   inherited Destroy;
  92. end;
  93.  
  94. function TVector.GetMagSquared: Real;
  95. var
  96.   i: Word;
  97.   x: Real;
  98.   s: Double;
  99. begin
  100.   s := 0.0;
  101.   for i := 1 to Count do
  102.      begin
  103.      x := GetElement(i);
  104.      s := s+x*x;
  105.      end;
  106.   Result := s;
  107. end;
  108.  
  109. function TVector.GetMagnitude: Real;
  110. begin
  111.   Result := sqrt(GetMagSquared);
  112. end;
  113.  
  114. procedure TVector.Scale(a:Real);
  115. var
  116.   i: Word;
  117. begin
  118.   for i := 1 to Count do SetElement(a*GetElement(i),i);
  119. end;
  120.  
  121. procedure TVector.Normalize;
  122. var
  123.   d: Real;
  124. begin
  125.   d := GetMagnitude;
  126.   Scale(1./d);
  127. end;
  128.  
  129. function TVector.Clone: TVector;
  130. var
  131.   i: Word;
  132.   v: TVector;
  133. begin
  134.   v := TVector.Create;
  135.   for i := 1 to Count do v.Add(GetElement(i));
  136.   Result := v;
  137. end;
  138.  
  139. procedure TVector.Sum(a: Real; v: TVector);
  140. var
  141.   i: Word;
  142.   u: TVector;
  143. begin
  144.   if Count <> v.Count then raise EUnequalVectorLength.Create('Vectors of unequal length in sum');
  145.   u := v.Clone;
  146.   u.Scale(a);
  147.   for i := 1 to Count do SetElement(GetElement(i)+u.GetElement(i),i);
  148.   u.Destroy
  149. end;
  150.  
  151. function TVector.Dot(v: TVector): Real;
  152. var
  153.   x: Real;
  154.   i: Word;
  155. begin
  156.   if Count <> v.Count then raise EUnequalVectorLength.Create('Vectors of unequal length in dot product');
  157.   x := 0;
  158.   for i := 1 to Count do x := x + GetElement(i)*v.GetElement(i);
  159.   Result := x;
  160. end;
  161.  
  162. end.